VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDirSendUserAccess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Sub SendUserAccess()

Dim sConnStr As String
Dim adoConn As ADODB.Connection
Dim adoSupportMsg As ADODB.Recordset
Dim sSupportMsg As String
Dim adoNewUsers As ADODB.Recordset
Dim sUserName As String
Dim sAuthorised As String
Dim sFullName As String
Dim sCreatedBy As String
Dim sEmailAddress As String
Dim adoAuthorise As ADODB.Recordset
Dim adoPassword As ADODB.Recordset
Dim sPassword As String
Dim cJMail As clsJMail
Dim sEMailBody As String
Dim adoUpdate As ADODB.Recordset

Set objReg = New clsRegistry
sConnStr = Encrypt(objReg.AdoConnectString, "richardknowles")

'create connection to SQL Server
Set adoConn = New ADODB.Connection
adoConn.CursorLocation = adUseClient
adoConn.ConnectionString = sConnStr

adoConn.Open

' Get email footnote
Set adoSupportMsg = New ADODB.Recordset
adoSupportMsg.Open "dir_get_email_footnote", adoConn
If Not adoSupportMsg.EOF Then
    sSupportMsg = adoSupportMsg(0)
End If
adoSupportMsg.Close
Set adoSupportMsg = Nothing

' Get addresses and passwords
Set adoNewUsers = New ADODB.Recordset
adoNewUsers.Open "Dir_get_new_users", adoConn
While Not adoNewUsers.EOF
    sUserName = adoNewUsers.Fields(0)
    sAuthorised = adoNewUsers.Fields(1)
    sFullName = adoNewUsers.Fields(2)
    sCreatedBy = adoNewUsers.Fields(3)
    sEmailAddress = adoNewUsers.Fields(4)
    
    If sAuthorised = "N" Then
        Set adoAuthorise = New ADODB.Recordset
        adoAuthorise.Open "dir_allowed_function " & sCreatedBy & ", ADD_USER", adoConn
        If Not adoAuthorise.EOF Then
            sAuthorised = adoAuthorise(0)
        End If
        adoAuthorise.Close
        Set adoAuthorise = Nothing
    End If
    
    If sAuthorised = "Y" Then
        
        Set adoPassword = New ADODB.Recordset
        adoPassword.Open "dir_generate_password", adoConn
        If Not adoPassword.EOF Then
            sPassword = adoPassword(0)
        End If
        adoPassword.Close
        Set adoPassword = Nothing
    
        Set cJMail = New clsJMail
        
        ' Email Body
        sEMailBody = "Dear " & sFullName & "," & vbCrLf & vbCrLf
        sEMailBody = sEMailBody & "Thank you for registering as a KeyTax user. Your KeyTax password is: " & sPassword & vbCrLf & vbCrLf
        sEMailBody = sEMailBody & sSupportMsg & vbCrLf & vbCrLf
        sEMailBody = sEMailBody & "Thank you," & vbCrLf
        'sEMailBody = sEMailBody & "Jacqui Braz for KeyTax." & vbCrLf
        sEMailBody = sEMailBody & "Mindkey Software Solutions (Pty) Ltd" & vbCrLf & vbCrLf & vbCrLf
    
        'Send Mail
        cJMail.EMailServer = "trend1.liberty.co.za"
        cJMail.MsgFrom = "info@keytax.co.za"
        cJMail.MSGFromName = "KeyTax: Tax Directives"
        cJMail.MSGSubject = "KeyTax Access"
        cJMail.MSGBody = sEMailBody
        cJMail.MSGRecpientName = sFullName
        cJMail.AddRecipient sEmailAddress
        'cJMail.MSGRecpientName = "KeyTax: Tax Directives"
        'cJMail.AddRecipient "info@keytax.co.za"
        If Not cJMail.SendMSG Then
          cJMail.EMailServer = "trend1.liberty.co.za"
          cJMail.MsgFrom = "info@keytax.co.za"
          cJMail.MSGFromName = "KeyTax: Tax Directives"
          cJMail.MSGSubject = "Registration Failed"
          cJMail.MSGBody = "Online Registration of user " & sFullName & " (" & sEmailAddress & ") has failed for the following reason: " & vbCrLf & sError
          cJMail.MSGRecpientName = "KeyTax: Tax Directives"
          cJMail.AddRecipient "info@keytax.co.za"
          cJMail.SendMSG
        End If
        Dim strTemp As String
        strTemp = "Dir_Insert_Password " & sUserName & ", " & sPassword
        adoConn.Execute strTemp
    
        Set cJMail = Nothing
        
    End If
    
    ' Get Next
    adoNewUsers.MoveNext

Wend
adoNewUsers.Close
Set adoNewUsers = Nothing

'close and release connection to SQL Server
adoConn.Close
Set adoConn = Nothing

Set objReg = Nothing

End Sub
